Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-19/reptext.lsp

Lisp/Scheme | 1993-05-05 | 8KB | 229 lines

;;; REPTEXT.LSP 3.xx is a substantially rewritten version compared to
;;; version 2.xx.  Please see the * HISTORY * section below.

;;; REPTEXT.LSP is an AutoCAD Release 12 utility to search & replace
;;; text items in a drawing, including within block definitions,
;;; dimensions, and attributes.  It will also process these entities in
;;; nested blocks to any depth.

;;; This routine can be used to search for all or selected instances of
;;; a particular text string, and replace them with a different string.
;;; This is most useful for global replacement of references, phrases,
;;; and control codes.  As an example, this routine could be used to
;;; replace the old Release 10-style %%127, 128 and 129 control codes,
;;; with the later %%d, %%p and %%c codes respectively.

;;;                            * USAGE *

;;; After loading the routine (eg. (load "reptext")) and executing by
;;; typing REPTEXT at the Command: prompt, there are only five or six
;;; prompts to respond to.  First you will be asked to specify the text
;;; string to search for, and the string to replace it with.  Both can
;;; contain spaces.  The search string is not case sensitive.

;;; You are then asked what entity types you wish to process.  These can
;;; be normal text, dimension user-supplied text, blocks (containing any of
;;; the other entity types, including nested blocks), and block attribute
;;; values.  If you respond with Y or Yes to any of these, any relevant
;;; selected entities will be processed.  Responding Y or Yes to blocks
;;; will also ask if attribute values are to be processed.  A negative
;;; answer to all entity types will repeat the prompt sequence.

;;; Lastly, you are asked to select the entities to modify.  You can do
;;; this with any of the normal AutoCAD entity selection methods (including
;;; ALL, to process the entire drawing).  REPTEXT will filter out the
;;; required entities.

;;; The routine will then start processing - you will see text entities
;;; being dynamically altered on screen.  Block definitions will be
;;; regenerated on screen after processing is complete.  Have fun!

;;;                                       Peter J T Heald, Autodesk UK Ltd.
;;;                                       Tech are the biz.

;;;                           * HISTORY *

;;; The main changes between version 2.xx and this version are as follows:

;;;     Associative dimensions will not loose their updated text values
;;;       during stretching and moving.
;;;     Block attribute values will now be processed.
;;;     Dimensions, text, blocks & attributes within blocks will now be
;;;       processed no matter what the level of nesting.

;;; The main reason for rewriting was because version 2.xx was pretty naf.
;;; Notation will be added to the code at some stage, when I have time...
;;; Any comments or suggestions relating to this routine are most welcome.

;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;; WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.

(prompt " REPTEXT.LSP by P.Heald Sept'92-Apr'93 Ver. 3.01\n")

;;; Global variables are: blist oldtxt newtxt txttoo dimtoo blktoo atttoo

(defun  c:reptext ( / sslist ss count en bllen bdata nen)
(setvar "cmdecho" 0)
(setq   oldtxt  (getstring T "\nText to search for: ")
        newtxt  (getstring T "\nReplace with: ")
        txttoo  F
        dimtoo  F
        blktoo  F
)
(while  (not (or txttoo dimtoo blktoo))
    (prompt "\nSelect desired operation.")
    (initget "Yes No")
    (setq   txttoo (getkword "\nProcess normal text? <Y> : ")
            sslist  '((-4 . "<OR"))
    )
    (if     (= txttoo "No")
            (setq   txttoo  F)
            (setq   sslist  (append sslist '((0 . "TEXT")))
                    txttoo  T
            )
    )
    (initget "Yes No")
    (setq   dimtoo  (getkword "\nProcess dimensions? <N> : "))
    (if     (= dimtoo "Yes")
            (setq   sslist  (append sslist '((0 . "DIMENSION"))))
            (setq   dimtoo  F)
    )
    (initget "Yes No")
    (setq   blktoo  (getkword "\nProcess blocks? <N> : "))
    (if     (= blktoo "Yes")
            (progn  (initget "Yes No")
                    (setq   sslist  (append sslist '((0 . "INSERT")))
                       atttoo  (getkword "\nProcess attributes? <N> : ")
                    )
            )
            (setq  blktoo  F)
    )
    (if     (/= atttoo "Yes") (setq atttoo F))
)
(setq   sslist  (append sslist '((-4 . "OR>")))
        ss      (ssget  sslist)
        count   0
        blist   (list)
)
(prompt "\nProcessing:-\n")
(repeat (sslength ss)
        (setq   en      (ssname ss count)
                 count   (1+ count)
        )
        (entscan en oldtxt newtxt)
        (prompt (strcat "\r" (itoa count) " done."))
)
(prompt "\rDone      ")
(setq   count   0
        bllen   (length blist)
)
(if     (> bllen 0) (prompt "\nProcessing blocks:-\n"))
(while  (and (> bllen 0) (setq   bname   (nth count blist)))
        (setq   count   (1+ count)
                bdata   (tblsearch "BLOCK" bname)
                nen     (cdr (assoc -2 bdata))
        )
        (while  (and  nen
                      (/= (cdr (assoc 0 (entget nen))) "ENDBLK")
                )
                (entscan nen oldtxt newtxt)
                (setq   nen     (entnext nen))
        )
        (prompt (strcat "\r" (itoa count) " done."))
)
(prompt "\rDone      ")
(if     (or dimtoo blktoo)
        (progn  (prompt "\nRegenerating drawing.")
                (command ".regen")
        )
)
(princ)
)

(defun  entscan (en oldtxt newtxt / ed et 2f tmp)
(setq   ed      (entget en)
        et      (cdr (assoc 0 ed))
        2f      (cdr (assoc 2 ed))
)
(cond   ((and (= et "TEXT") txttoo) (swaptext en oldtxt newtxt))
        ((and (= et "DIMENSION") dimtoo)
                (progn (swaptext en oldtxt newtxt)
                       (if      (setq tmp (chklist blist 2f))
                                (setq blist tmp)
                       )
                )
        )
        ((and (= et "INSERT") blktoo)
                (progn  (if     (setq tmp (chklist blist 2f))
                                (setq blist tmp)
                        )
                        (if     (and atttoo (cdr (assoc 66 ed)))
                                (attscan en oldtxt newtxt)
                        )
                )
        )
)
)

(defun attscan (ename otxt ntxt / edata parent etype)
(setq   edata   (entget ename)
        parent  edata
        etype   "INSERT"
)
(while  (and ename (/= etype "SEQEND"))
        (setq   ename (entnext ename))
        (if     ename   (setq   edata   (entget ename)
                                etype   (cdr (assoc 0 edata))
                        )
        )
        (if (= etype "ATTRIB")  (swaptext ename otxt ntxt))
)
(entmod parent)
)


(defun  swaptext (ename otxt ntxt / edata oldt newt edata)
(setq   edata   (entget ename)
        oldt    (assoc 1 edata)
)
(if     oldt
        (progn  (setq   newt    (cons 1 (swapstr (cdr oldt) otxt ntxt))
                        edata   (subst newt oldt edata)
                )
                (entmod edata)
        )
)
)

(defun  swapstr (line oldstr newstr / charpos oldlen)
(setq   oldlen  (strlen  oldstr)
        oldstr  (strcase oldstr)
        charpos 1
)
(repeat (1+ (- (strlen line) oldlen))
        (if     (= (strcase (substr line charpos oldlen)) oldstr)
                (setq   line    (strcat (substr line 1 (1- charpos))
                                         newstr
                                        (substr line (+ charpos oldlen))
                                )
                        charpos (+ charpos (strlen newstr))
                )
        )
        (setq   charpos (1+ charpos))
)
(setq line line)
)

(defun  chklist (itemlist itemname)
(if     (member itemname itemlist)
        (setq   itemlist F)
        (setq   itemlist (append itemlist (list itemname)))
)
)

(princ)

; - - - - - - - - - - - - - - - - - - - End